/*
 * Funny Language - a free style programming language.
 * Copyright (C) 2015 by fanguangping (fanguangping@163.com)
 * character.c
 */

#include <stdlib.h>
#include <ctype.h>
#include "../basic/operator.h"

const char *CHAR_NAMES[32] = {
        "nul", "soh", "stx", "etx", "eot", "enq",
        "ack", "bel", "bs", "ht", "lf", "vt", "ff", "cr", "so", "si", "dle",
        "dc1", "dc2", "dc3", "dc4", "nak", "syn", "etb", "can", "em", "sub",
        "esc", "fs", "gs", "rs", "us"
};

Cell* make_character(Scheme *sc, int c) {
	Cell* x = make_cell(sc, &g_nil, &g_nil);
	(x)->_type = CHARACTER_TYPE;
	(x)->_longValue = (long) c;
	return (x);
}

#define CHAR_STR_LENGTH 20

char* char2string(int c) {
	char *p = (char *)malloc(CHAR_STR_LENGTH * sizeof(char));
	switch (c) {
		case ' ':
			snprintf(p, CHAR_STR_LENGTH, "#\\space");
			break;
		case '\n':
			snprintf(p, CHAR_STR_LENGTH, "#\\newline");
			break;
		case '\r':
			snprintf(p, CHAR_STR_LENGTH, "#\\return");
			break;
		case '\t':
			snprintf(p, CHAR_STR_LENGTH, "#\\tab");
			break;
		default:
			if (c == 127) {
				snprintf(p, CHAR_STR_LENGTH, "#\\del");
				break;
			} else if (c < 32) {
				snprintf(p, CHAR_STR_LENGTH, "#\\%s", CHAR_NAMES[c]);
				break;
			}
			snprintf(p, CHAR_STR_LENGTH, "#\\%c", c);
			break;
	}
	return p;
}

// (char->integer c)
Cell* op_char_to_integer(Scheme *sc) {
	Cell* x = first(sc->args);
	TYPE_CHECK(sc, x, CHARACTER_TYPE);
	long v = x->_longValue;
    if (v >= '0' && v <= '9') {
        sc->returnValue = make_integer(sc, v - '0');
    } else if (v >= 'a' && v <= 'f') {
        sc->returnValue = make_integer(sc, v - 'a' + 10);
    } else if (v >= 'A' && v <= 'F') {
        sc->returnValue = make_integer(sc, v - 'A' + 10);
    } else {
        sc->returnValue = make_default_exception(sc, "NOT_DIGIT", "Not a digit.");
    }
	return pop_callstack(sc);
}

// (char->string c)
Cell* op_char_to_string(Scheme *sc) {
	Cell* x = first(sc->args);
	TYPE_CHECK(sc, x, CHARACTER_TYPE);
	char *p = (char *)malloc(2 * sizeof(char));
	p[0] = (int)(x->_longValue);
	p[1] = 0;
	sc->returnValue = make_string(sc, p);
	return pop_callstack(sc);
}

// (char->charname c)
Cell* op_char_to_charname(Scheme *sc) {
	Cell* x = first(sc->args);
	TYPE_CHECK(sc, x, CHARACTER_TYPE);
	sc->returnValue = make_string(sc, char2string(x->_longValue));
	return pop_callstack(sc);
}

//是否是字母
static int isalphax(int c) {
	return isascii(c) && isalpha(c);
}
//是否是数字
static int isdigitx(int c) {
	return isascii(c) && isdigit(c);
}
//是否是空格
static int isspacex(int c) {
	return isascii(c) && isspace(c);
}
//是否是大写字母
static int isupperx(int c) {
	return isascii(c) && isupper(c);
}
//是否是小写字母
static int islowerx(int c) {
	return isascii(c) && islower(c);
}

// (char-alphabetic? x)
Cell* op_charap(Scheme *sc) {
	Cell* x = first(sc->args);
	TYPE_CHECK(sc, x, CHARACTER_TYPE);
	int istrue = (isalphax(x->_longValue));
	sc->returnValue = (istrue) ? &g_true : &g_false;
	return pop_callstack(sc);
}

// (char-numeric? x)
Cell* op_charnp(Scheme *sc) {
	Cell* x = first(sc->args);
	TYPE_CHECK(sc, x, CHARACTER_TYPE);
	int istrue = (isdigitx(x->_longValue));
	sc->returnValue = (istrue) ? &g_true : &g_false;
	return pop_callstack(sc);
}

// (char-whitespace? x)
Cell* op_charwp(Scheme *sc) {
	Cell* x = first(sc->args);
	TYPE_CHECK(sc, x, CHARACTER_TYPE);
	int istrue = (isspacex(x->_longValue));
	sc->returnValue = (istrue) ? &g_true : &g_false;
	return pop_callstack(sc);
}

// (char-upper-case? x)
Cell* op_charup(Scheme *sc) {
	Cell* x = first(sc->args);
	TYPE_CHECK(sc, x, CHARACTER_TYPE);
	int istrue = (isupperx(x->_longValue));
	sc->returnValue = (istrue) ? &g_true : &g_false;
	return pop_callstack(sc);
}

// (char-lower-case? x)
Cell* op_charlp(Scheme *sc) {
	Cell* x = first(sc->args);
	TYPE_CHECK(sc, x, CHARACTER_TYPE);
	int istrue = (islowerx(x->_longValue));
	sc->returnValue = (istrue) ? &g_true : &g_false;
	return pop_callstack(sc);
}

// (char-upcase x)
Cell* op_char_upcase(Scheme *sc) {
	Cell* x = first(sc->args);
	TYPE_CHECK(sc, x, CHARACTER_TYPE);
	unsigned char c = (unsigned char) (x->_longValue);
	c = toupper(c);
	sc->returnValue = make_character(sc, (char) c);
	return pop_callstack(sc);
}

// (char-downcase x)
Cell* op_char_downcase(Scheme *sc) {
	Cell* x = first(sc->args);
	TYPE_CHECK(sc, x, CHARACTER_TYPE);
	unsigned char c = (unsigned char) (x->_longValue);
	c = tolower(c);
	sc->returnValue = make_character(sc, (char) c);
	return pop_callstack(sc);
}

void init_character_operators(Scheme *sc) {
	ADD_OPERATOR(sc, "char->integer", char_to_integer);
	ADD_OPERATOR(sc, "char->string", char_to_string);
	ADD_OPERATOR(sc, "char->charname", char_to_charname);
	ADD_OPERATOR(sc, "char-alphabetic?", charap);
	ADD_OPERATOR(sc, "char-numeric?", charnp);
	ADD_OPERATOR(sc, "char-whitespace?", charwp);
	ADD_OPERATOR(sc, "char-upper-case?", charup);
	ADD_OPERATOR(sc, "char-lower-case?", charlp);
	ADD_OPERATOR(sc, "char-upcase", char_upcase);
	ADD_OPERATOR(sc, "char-downcase", char_downcase);
}

